00100	C TYPE 'DO DOD.DO'.
00110	C  'G' OR <CR> = GET.  'A'=ADD TO COMBINED FILE.
00200	C PC=PLOT  PX=XGP(→PLOT.BIN)  PXS,PCS=PLOT SMOOTHED CONTURE
00300	C  PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
00400	C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
00500	C  F=JUMP AND BEGIN FILL SECTION.  FX=EXIT AND FILL ALL.
00600	C SINGLE ITEM IS RESTRICTED TO 400 WDS. 10 ITEMS PER FILE.
00610	C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
00700		COMMON /RC/MCLEF(400),IST(4000)
00800		COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00900		COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
01100		COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
01300		DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
01400		COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
01460		EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
01510		1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
01600		1 ,(NMLST,IST(1510)),(JST,IST(500))
01700		DATA RJB/-20./,CENTR/-26./
01710		RSZ=0
01800	1	MCLEF(1)=0
02000		MM=0
02100		IPLT=0
02200		IPLTX=-1
02300		K=1
02500	91	TYPE 100
02600	55	FORMAT(I,2F)
02700	50	FORMAT(3A1)
02900		XSZ=RSZ
03000		ACCEPT 55,J,RSZ,GRID
03200		IF(RSZ.EQ.0)RSZ=XSZ
03300		MORE=-1
03400		REREAD 50,N,JC,JS
03410		IF(N.EQ.' ')GO TO 91
03500	C PXS,PCS=SMOOTH ONLY;  PXZ,PCZ=SMOOTH AND FILL
03600	C  TO SAVE SIZE FACTOR WHEN REDRAWING.
03610		IF(N.EQ.'Z')GO TO 1
03700		IF(RSZ.EQ.0)RSZ=9.0
03710		IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
03800		IF(N.EQ.'M'.OR.N.EQ.'R')GO TO 192
03850		IF(N.EQ.'V')CALL CNVT
03875	C  V=CONVERT FROM OLD FORMAT TO NEW.
03900	C  FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
03910		IF(N.EQ.'F')GO TO 79
03930	C  FILLS IT.
03950		IF(JS.EQ.'L')N='Z'
03975	C  DEL=DELETE FROM COMB. FILE.   (JS='L')
04000		IF(N.EQ.'C'.OR.N.EQ.'A'.OR.N.EQ.'Z')GO TO 999
04100		IF(N.EQ.'X')CALL EXIT
04200	C TYPE X TO FINISH PLOT, OTHERWISE NEW UNIT MAY BE READ IN.
04300		IF(N.EQ.'Q')GO TO 56
04350	C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
04400		IF(N.NE.'D'.AND.N.NE.'E')GO TO 191
04410	CC	IF(JC.EQ.'X')MCLEF(1)=0
04420	C  TYPE 'DX' TO START NEW DRAWING WITHOUT EXIT. (GOOD AFTER 'Q')
04500	
04600		KED=N
04700		MM=MCLEF(1)
04800		IF(MM.NE.0)GO TO 92
04900	C  ADD TO DRAWING?
05000		GO TO 3
05010	
05020	56	CALL POG2
05030		CALL RDRAW(2,MCLEF(1),MCLEF)
05035		CALL DPYOUT(2)
05040		CALL POG1
05050		GO TO 91
05100	999	CALL CMBN
05200		GO TO 111
05250	192	IF(N.EQ.'R')MCLEF(1)=-MCLEF(1)
05300		CALL SHIFT(MCLEF(2),MCLEF(1))
05400		J=1
05500		JC=0
05600		GO TO 333
05700	191	TYPE 41
05900		IF(JC.EQ.'M'.OR.N.EQ.'S')GO TO 194
06000		MCLEF(1)=0
06100		MM=0
06200		IPLTX=-1
06300		K=1
06400	194	IF(JC.EQ.'M')MORE=0
06500		JQ=JC
06600		JC=0
06700		JM=1
06900		IF(MCLEF(1).EQ.0)GO TO 193
07000	CC	JC=JCLEF(2)-1
07100	CC	JM=MCLEF(1)+1
07140		JM=MCLEF(1)+1
07200	193	ACCEPT 10,NM,PASS
07210		IF(NM.EQ.' ')NM=LASTNM
07300		IF(NM.EQ.' '.OR.NM.EQ.'99')GO TO 91
07305	C  '99'  WILL BACKUP
07310		IF(N.NE.'S')LASTNM=NM
07400	CC	REWIND 1
07500		IF(N.EQ.'S')GO TO 40
07600		IF(LOOKF(NM).EQ.0)GO TO 191
07700	C  'FAIL' ROUTINE TO CHECK ON LOOKUP
07800	CC	CALL IFILE(1,NM)
07900	CC	READ(1,5)M,JCLEF
07950		CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
07970	C  -1=READ
08000	C  CAN'T USE 'GM' WITH 'COMBINED' FILE.
08002	CC	JQ=0
08005	CC	IF(MORE.EQ.0.AND.JCLEF(3).NE.0)JQ=JM-1
08010		J=1
08020		IF(KCLEF(2).EQ.0)GO TO 290
08060	CC	IF(PASS.NE.0)CALL ITEM
08100		TYPE 1100
08200		ACCEPT 55,J
08300		J=J+1
08350	C  ITEMS ARE NUMBERED  0 THROUGH 9 (10 ITEMS).
08375		IF(J.GT.10)GO TO 191
08400	CC290	IC=KCLEF(K+1)-KCLEF(K)
08420	290	IC=KCLEF(J)+JST(KCLEF(J))-1
08450	CC	IF(J.EQ.10)IC=1000
08500		TYPE 110,IC
08600	CC	IF(J.LE.1)GO TO 60
08700	C  FOR PROTECTION
08800	CC	M=JCLEF(J)+1000
08900	CC	JZ=JM+1001
09000	CC	NX=1001
09100	CC61	READ(1,5)L,L,(MCLEF(K),K=JZ,JM+L)
09200	C PASSES OVER FIRST ITEMS
09300	CC	NX=NX+L
09400	CC	IF(NX.LT.M)GO TO 61
09500	CC60	NX=JM
09550	CC	IC=IC+JM
09600	CC6	READ(1,5,END=7)M,L,(MCLEF(M),M=NX,NX+L-1)
09800	CC	NX=NX+L
09900	CC	IF(NX.LT.IC)GO TO 6
09910	60	JZ=1
09915	CC	IF(MORE.EQ.0)JZ=MM+1
09917		IF(MORE.EQ.0)JZ=JM
09920		L=KCLEF(J)-1
09930		DO 61 K=JZ,JST(L+1)+JZ-1
09935		L=L+1
09937		M=K
09940	61	MCLEF(K)=JST(L)
09960		MCLEF(1)=M
10000	1100	FORMAT(' ITEM NUM?'/)
10100	700	FORMAT(' RESET X-Y POS. ',$)
10200	555	FORMAT(2F)
10300	7	IF(MORE)GO TO 70
10310	CC	JM=MM+IST(L+1)
10400		DO 771 K=2,JM
10500	771	IF(MCLEF(K).GE.200000000)GO TO 772
10600		GO TO 70
10700	CC772	M=0
10800	CC	L=NX-1
10900	CC	DO 773 J=K,L+JM-K
11000	CC	M=M+1
11100	CC	MCLEF(L+M)=MCLEF(J)
11200	C PUTS FILLER TO END
11300	CC773	MCLEF(J)=MCLEF(JM+M)
11400	C  MOVES OUTLINE UP FRONT
11700	CC	MCLEF(1)=L-1
11710	772	M=MCLEF(1)
11720		DO 773 L=K,JM
11730		M=M+1
11740	773	MCLEF(M)=MCLEF(L)
11750		K=MJ+K
11760		DO 774 L=JM,M
11770	774	MCLEF(L-K)=MCLEF(L)
11800		GO TO 3
11900	CC77	IF(JC.EQ.0)GO TO 70
12000	CC	NX=MCLEF(1)+1
12100	CC	NY=MCLEF(NX)-1
12200	C  THE WDCNTS
12300	CC	DO 71 K=NX,MCLEF(1)+NY
12400	CC71	MCLEF(K)=MCLEF(K+1)
12500	CC	MCLEF(1)=MCLEF(1)+NY
12510	CC	JCLEF(2)=MCLEF(1)+1
12600	
12700	70	IF(N.NE.'P')GO TO 3
12800		IXRX=-1
12900		IF(JQ.NE.'X')IXRX=0
13000	C 0=SEND IT TO CALCOMP
13100		TYPE 700
13200		ACCEPT 555,X,Y
13300		IF(X.NE.0)RJB=X/RSZ
13400		IF(Y.NE.0)CENTR=Y/RSZ
13500	C  TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
13600		IF(IPLTX)CALL PLOTS(0)
13700	C  DO I NEED THIS?
13710		IF(GRID.GT.0)CALL GRIDS
13800		IPLTX=0
13900		IPLT=-1
14000	3	IF(N.NE.'D')MM=0
14100	C  RESET IF NOT GOING TO DRAWIT
14400	333	IF(N.EQ.'P')GO TO 337
14500		CALL DPYSET(1,IST,4000)
14600		CALL DPYBRT(4)
14700		NIST=IST(2)
14800		IF(N.AND.N.NE.'G'.AND.N.NE.'M'.AND.N.NE.'R')GO TO 92
14900	CC337	JJ=MCLEF(1)
15000	337	IF(JS.EQ.'Z')GO TO 306
15100		IF(JS.NE.'S')GO TO 338
15200		CALL SMOOTH(JS)
15300		GO TO 436
15400	338	IC=-1
15500		MM=1
15600		DO 335 K=2,MCLEF(1)
15700		IF(MCLEF(K).LT.200000000)GO TO 335
15800	CC	CALL DPYBRT(3)
15900	CC	CALL RDRAW(K,MCLEF(1),MCLEF)
15910	CC	CALL DPYOUT(1)
16000	CC	CALL DPYBRT(4)
16100	CC	JJ=K-1
16200		IC=K
16300		GO TO 334
16400	C FOR 1ST LOC. OF MCLEF IN FILLER
16500	335	CONTINUE
16600	334	CALL RDRAW(2,MCLEF(1),MCLEF)
16700		CALL DPYOUT(1)
16800		NIST=IST(2)
16900	CC	IF(JJ.EQ.MCLEF(1))GO TO 436
16950		GO TO 436
17000	C NO FILLER
17010	79	IF(IC)GO TO 91
17020	C  IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
17100		TYPE 336
17200		ACCEPT 10,J
17300		JZ=N
17400	CC	IF(J.NE.'Y'.AND.J.NE.'S')GO TO 436
17500		KK=0
17600		IF(J.NE.'Y')GO TO 206
17610	CC	IF(J.NE.'S')GO TO 206
17700	306	CALL SMOOTH(0)
17750	C  SMOOTHS AND FILLS
17800		GO TO 436
17900	206	RR=RSZ
18100		DO 205 J=IC,MCLEF(1)
18200		CALL UNPACK(J,M,N,MCLEF)
18300		KK=KK+1
18400		NF(KK)=0
18500		IF(LL.GE.100000000)NF(KK)=3
18600		QF(KK)=(M+RJB)*RR
18700	205	RF(KK)=(N+CENTR)*RR
18800		NF(1)=KK
18900		CALL FILLQ(QF,RF,NF)
19000	436	IF(JZ.EQ.'P')CALL PLOT(0,0,3)
19100		GO TO 91
19105	
19110	66	TYPE 666,NM
19120		GO TO 91
19130	666	FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
19200	336	FORMAT(' SMOOTH? ',$)
19300	10	FORMAT(A5,F)
19400	5	FORMAT(12I)
19500	100	FORMAT(' G=GET, GM=GET MORE, =S=SAVE, D=DRAW, X=EXIT, M=MOVE,'/'
19600		1 P=PLOT, PX=XGP, C=COMBINE, A=ADD TO COMB. FILE
19650		1, DEL=DEL. FROM COMB.'/
19700		1' F=FILL,  E=EDIT,   N1=SIZE, N2=1=GRID '/)
19800	C  N1=20 TO CHANGE SHAPE
19900	
20000	92	IST(2)=NIST
20100		CALL DRAWIT
20200	  	N=0
20300		GO TO 3
20400	
20500	403	FORMAT(' WRITE OVER ',A5,'.DMD?  ',$)
20600	41	FORMAT(' TYPE FILE NAME'/)
20700	C  SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
20800	40	IF(LOOKF(NM).EQ.0)GO TO 402
20900		TYPE 403,NM
21000		ACCEPT 50,K
21100		IF(K.EQ.'N')GO TO 191
21200	CC402	IC=MCLEF(1)+1
21210	402	NMLST(1)=NM
21220		JCLEF(1)=1
21230		DO 1111 K=2,10
21240		JCLEF(K)=0
21250	1111	NMLST(K)=' '
21260		CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
21280		NQ=MCLEF(1)
21300	CC	CALL OFILE(1,NM)
21400	CC	WRITE(1,120),IC
21500	CC	CALL SAVE(MCLEF)
21510	CC	WRITE(1,1111)NM
21555	CC1111	FORMAT(' 9999 ',A5)
21600	111	TYPE 110,NQ
21610	CC	END FILE(1)
21615	CC	TYPE 1111,NM
21620		GO TO 91
21700	CC120	FORMAT(' 9999  1 ',I4,' 0 0 0 0 0 0 0 0')
21800	110	FORMAT(' TOTAL WDS=',I3)
21900		END